home *** CD-ROM | disk | FTP | other *** search
/ Light ROM 1 / LIGHT-ROM 1 (Amiga Library Services)(1994).iso / ffdisks / d996.lha / Startup-Menu / Source / SMPrefs / main.PAS < prev    next >
Pascal/Delphi Source File  |  1994-04-05  |  24KB  |  683 lines
  1. (* SMPrefs. Creates a data file which is stored
  2.  * in S: which holds the description of gadgets required on the menu.
  3.  * Lee Kindness Jan '94 HSP source.
  4.  * v1.00
  5.  *)
  6.   
  7. Program SMPrefs(input, output);
  8.  
  9. Uses Exec, Intuition, utility, gadtools, graphics, DiskFont, 
  10.         ASL, AmigaDOS, LSKExtras, Amiga, IFFParse, DOS, ReqTools;
  11.  
  12. (*$I SMEditor.h *)
  13. (*$I Config.PAS *)
  14. (*$I List.PAS   *)
  15. (*$I Window.PAS *)
  16.        
  17.  
  18. (* ===================================================================== *)
  19.  
  20. Procedure Close_Window;
  21.  
  22. Begin
  23.    CloseWindow(TheWindow);       (* close window and free gadgets and *)
  24.    FreeGadgets(gads[G_NI]);      (* visualinfo                        *)
  25.    FreeVisualInfo(vi);
  26. End;
  27.  
  28. (* ===================================================================== *)
  29.  
  30. Procedure GetTitles;
  31. VAR
  32.     buffer: Pointer;
  33.     values: argarray;
  34.     ret   : Long;
  35.     tags  : array [0..4] of tTagItem;
  36.     
  37. begin
  38.     wl := rtLockWindow(TheWindow);
  39.     tags[0].ti_Tag  := RT_Window;
  40.     tags[0].ti_Data := LONG(TheWindow);
  41.     tags[1].ti_Tag  := RTGS_TextFmt;
  42.     tags[1].ti_Data := LONG(CStrConstPtr('Enter the text to be displayed'+#10+' on the screen titlebar.'));
  43.     tags[2].ti_Tag  := RTGS_FLAGS;
  44.     tags[2].ti_Data := GSREQF_CENTERTEXT;
  45.     tags[3].ti_Tag  := TAG_END;
  46.     
  47.     buffer := @CD.cd_ScrTit[1];
  48.     ret:=rtGetStringA (buffer, 127, 'SMPrefs', NIL, @tags);
  49.     values[0]:=LongInt(buffer);
  50.     if ret <> 0 then
  51.         CD.cd_ScrTit := retrievestr(Pointer(values[0])) + #0;
  52.     
  53.     buffer := @CD.cd_WinTit[1];
  54.     tags[1].ti_Data := LONG(CStrConstPtr('Enter the text to be displayed'+#10+' on the window titlebar.'));
  55.     ret:=rtGetStringA (buffer, 127, 'SMPrefs', NIL, @tags);
  56.     values[0] := LongInt(buffer);
  57.     if ret <> 0 then 
  58.         CD.cd_WinTit := retrievestr(Pointer(values[0])) + #0;
  59.     tl := rtUnLockWindow(TheWindow, pointer(wl));
  60. end;
  61.  
  62. (* ===================================================================== *)
  63.  
  64. Procedure GetPal;
  65.  
  66. CONST
  67.     MyPens : Array[0..8] of Word = ($FFFF); (* Get default *)
  68.     
  69. VAR
  70.     result : Long;
  71.     tags : array [0..10] of tTagItem;
  72.     TheScreen : pScreen;
  73.     win : pWindow;
  74.     ok : boolean;
  75.     MyTextFont : pTextFont;
  76.     
  77. begin
  78.     wl := rtLockWindow(TheWindow);
  79.     
  80.     DiskFontBase  := Openlibrary('diskfont.library',36); 
  81.    If DiskFontBase <> NIL Then begin
  82.         MyTextFont := OpenDiskFont(@CD.cd_Font);
  83.         CloseLibrary(pLibrary(DiskFontBase));
  84.     end;
  85.     
  86.     tags[0].ti_Tag  := SA_Type;
  87.    tags[0].ti_Data := CUSTOMSCREEN;
  88.    tags[1].ti_Tag  := SA_Title;
  89.    tags[1].ti_Data := LONG(CStrConstPtr('Change the palette'));
  90.    tags[2].ti_Tag  := SA_OverScan;
  91.    tags[2].ti_Data := OSCAN_TEXT;
  92.    tags[3].ti_Tag  := SA_Depth;
  93.    tags[3].ti_Data := 2;
  94.    tags[4].ti_Tag  := SA_Font;
  95.    tags[4].ti_Data := LONG(@CD.cd_Font);
  96.    tags[5].ti_Tag  := SA_DisplayID;
  97.    tags[5].ti_Data := CD.cd_ModeID; 
  98.    tags[6].ti_Tag  := SA_Width;
  99.    tags[6].ti_Data := STDSCREENWIDTH;
  100.    tags[7].ti_Tag  := SA_Height;
  101.    tags[7].ti_Data := STDSCREENHEIGHT;
  102.    tags[8].ti_Tag  := SA_Pens;
  103.    tags[8].ti_Data := LONG(@MyPens);
  104.    tags[9].ti_Tag  := SA_Colors;
  105.    tags[9].ti_Data := LONG(NIL);
  106.    tags[10].ti_Tag  := TAG_END;
  107.    
  108.    TheScreen := OpenScreenTagList(NIL, @tags);
  109.    IF TheScreen <> NIL then begin
  110.        LoadRGB4(@TheScreen^.ViewPort, @CD.cd_Pal[0], 4);
  111.        tags[0].ti_Tag  := RT_Screen;
  112.         tags[0].ti_Data := LONG(TheScreen);
  113.         tags[1].ti_Tag  := TAG_END;
  114.             
  115.         result := rtPaletteRequestA ('Change palette', NIL, @tags);
  116.         if result <> -1 then begin
  117.             CD.cd_Pal[0] := GetRGB4(TheScreen^.ViewPort.ColorMap,0);
  118.             CD.cd_Pal[1] := GetRGB4(TheScreen^.ViewPort.ColorMap,1);
  119.             CD.cd_Pal[2] := GetRGB4(TheScreen^.ViewPort.ColorMap,2);
  120.             CD.cd_Pal[3] := GetRGB4(TheScreen^.ViewPort.ColorMap,3);
  121.         end;
  122.         ok := CloseScreen(TheScreen);
  123.    end;
  124.    tl := rtUnLockWindow(TheWindow, pointer(wl));
  125. end;
  126.  
  127.  
  128.         
  129. (* ===================================================================== *)
  130.  
  131. Function GetSCRID : LongInt;      (* Use Reqtools to get ModeID *)
  132. VAR
  133.     scrnreq: prtScreenModeRequester;
  134.     Value : Longint;
  135.     ret : longint;
  136.     mytag : Array[0..3] of tTagItem;
  137.     
  138. Begin
  139.     wl := rtLockWindow(TheWindow);
  140.     scrnreq := Pointer(rtAllocRequestA (RT_SCREENMODEREQ, NIL));
  141.     if (scrnreq<>NIL) then begin
  142.         scrnreq^.DisplayID := CD.cd_ModeID;
  143.         mytag[0].ti_Tag:=RTSC_Flags;
  144.         mytag[0].ti_Data:= 0;
  145.         mytag[1].ti_Tag:=RT_UnderScore;
  146.         mytag[1].ti_Data:=LongInt('_');
  147.         mytag[2].ti_Tag := RT_Window;
  148.         mytag[2].ti_Data := LONG(TheWindow);
  149.         mytag[3].ti_Tag:=TAG_END;
  150.  
  151.         ret:=rtScreenModeRequestA ( scrnreq, 'Pick a screenmode', @mytag);
  152.         value :=LongInt(scrnreq^.DisplayID);
  153.     end ;
  154.     ret:=rtFreeRequest (scrnreq);
  155.     GetSCRID := value;
  156.     tl := rtUnLockWindow(TheWindow, pointer(wl));
  157. end;            
  158.  
  159. (* ===================================================================== *)
  160.  
  161. Procedure HandleIDCMP;
  162.  
  163. Type
  164.     strarray = Array[1..3] Of string;
  165.     Tag2     = Array[0..8] Of tTagItem;
  166.     
  167. Const
  168.    exitflag : Boolean  = False; 
  169.    small    : Boolean  = False;
  170.    NumStrs  : shortint = 3;
  171.    
  172. Var 
  173.     dummy, dum, ret : longint;      (* the main loop of the program. *)
  174.     Tags       : tag2;              (* monitors IDCMP messages and   *)
  175.    message    : pIntuiMessage;     (* responds as appropriate       *)
  176.    MsgClass   : LongInt;
  177.    MsgCode    : Word;
  178.    gadcode    : pGadget;
  179.    StrInfo    : pStringInfo;
  180.    tempint    : Array[1..4] Of longint;
  181.    OKRes      : boolean;
  182.     i, cnt     : Longint;
  183.     tmpstr     : string;
  184.     fr         : pFontRequester;
  185.     lr, sr, cr : pFileRequester;
  186.     cfile      : PathStr;
  187.     cdir       : DirStr;
  188.  
  189. Procedure TxtInGads(curnode : pMyNode);
  190.  
  191. begin
  192.     Tags[0].ti_Tag  := GTST_String;
  193.     Tags[0].ti_Data := LONG(@currentnode^.LSK_Name[1]);
  194.     Tags[1].ti_Tag  := TAG_END;
  195.     GT_SetGadgetAttrsA(gads[G_S_TXT], TheWindow, NIL, @Tags);
  196.  
  197.     Tags[0].ti_Tag  := GTST_String;
  198.     Tags[0].ti_Data := LONG(@currentnode^.LSK_Cmd[1]);
  199.     Tags[1].ti_Tag  := TAG_END;
  200.     GT_SetGadgetAttrsA(gads[G_S_CMD], TheWindow, NIL, @Tags);
  201.  
  202.     Tags[0].ti_Tag  := GTST_String;
  203.     Tags[0].ti_Data := LONG(@currentnode^.LSK_Key[1]);
  204.     Tags[1].ti_Tag  := TAG_END;
  205.     GT_SetGadgetAttrsA(gads[G_S_KEY], TheWindow, NIL, @Tags);
  206. end;
  207.  
  208. Begin
  209.     Tags[0].ti_Tag  := ASL_Hail;
  210.     Tags[0].ti_Data := LONG(CstrConstPtrAR(@RememberKey, 'Pick a font'));
  211.       Tags[1].ti_Tag  := ASL_FontName;
  212.     Tags[1].ti_Data := LONG(CD.cd_Font.ta_Name);
  213.     Tags[2].ti_Tag  := ASL_FontHeight;
  214.     Tags[2].ti_Data := long(CD.cd_Font.ta_YSize);
  215.     Tags[3].ti_Tag  := ASL_MinHeight;
  216.     Tags[3].ti_Data := 6;
  217.     Tags[4].ti_Tag  := ASL_MaxHeight;
  218.     Tags[4].ti_Data := 30;
  219.     Tags[5].ti_Tag  := ASL_FuncFlags;
  220.     Tags[5].ti_Data := FONF_STYLES;
  221.     Tags[6].ti_Tag  := ASL_Window;
  222.     Tags[6].ti_Data := long(TheWindow);
  223.     Tags[7].ti_Tag  := ASL_FontStyles;
  224.     Tags[7].ti_Data := long(CD.cd_Font.ta_Style);
  225.     Tags[8].ti_Tag  := TAG_DONE;
  226.  
  227.  
  228.     fr := AllocASLRequest(ASL_FontRequest, @Tags[0]);
  229.     
  230.     Tags[0].ti_Tag  := ASL_Hail;
  231.     Tags[0].ti_Data := LONG(CstrConstPtrAR(@RememberKey, 'Locate the prefs file'));
  232.     Tags[1].ti_Tag  := ASL_File;
  233.     Tags[1].ti_Data := LONG(@PREFSNAME[1]);
  234.     Tags[2].ti_Tag  := ASL_Dir;
  235.     Tags[2].ti_Data := long(@PREFSDIRH[1]);
  236.     Tags[3].ti_Tag  := ASL_Window;
  237.     Tags[3].ti_Data := long(TheWindow);
  238.     Tags[4].ti_Tag  := ASL_FuncFlags;
  239.     Tags[4].ti_Data := 0;
  240.     Tags[5].ti_Tag  := ASL_Pattern;
  241.     Tags[5].ti_Data := LONG(CstrConstPtrAR(@RememberKey, '#?.prefs'));
  242.     Tags[6].ti_Tag  := TAG_DONE;
  243.  
  244.     lr := AllocASLRequest(ASL_FileRequest, @Tags[0]);
  245.  
  246.     Tags[0].ti_Tag  := ASL_Hail;
  247.     Tags[0].ti_Data := LONG(CstrConstPtrAR(@RememberKey, 'Pick Command'));
  248.     Tags[1].ti_Tag  := ASL_Window;
  249.     Tags[1].ti_Data := long(TheWindow);
  250.     Tags[2].ti_Tag  := ASL_FuncFlags;
  251.     Tags[2].ti_Data := 0;
  252.     Tags[3].ti_Tag  := ASL_Pattern;
  253.     Tags[3].ti_Data := LONG(CstrConstPtrAR(@RememberKey, '~(#?.info)'));
  254.     Tags[4].ti_Tag  := ASL_Dir;
  255.     Tags[4].ti_Data := long(CstrConstPtrAR(@RememberKey, 'SYS:'));
  256.     Tags[5].ti_Tag  := TAG_DONE;
  257.  
  258.     cr := AllocASLRequest(ASL_FileRequest, @Tags[0]);
  259.     
  260.     Tags[0].ti_Tag  := ASL_Hail;
  261.     Tags[0].ti_Data := LONG(CstrConstPtrAR(@RememberKey, 'Save prefs file as'));
  262.     Tags[1].ti_Tag  := ASL_File;
  263.     Tags[1].ti_Data := LONG(@PREFSNAME[1]);
  264.     Tags[2].ti_Tag  := ASL_Dir;
  265.     Tags[2].ti_Data := long(@PREFSDIRH[1]);
  266.     Tags[3].ti_Tag  := ASL_Window;
  267.     Tags[3].ti_Data := long(TheWindow);
  268.     Tags[4].ti_Tag  := ASL_FuncFlags;
  269.     Tags[4].ti_Data := FILF_SAVE;
  270.     Tags[5].ti_Tag  := ASL_Pattern;
  271.     Tags[5].ti_Data := LONG(CstrConstPtrAR(@RememberKey, '#?.prefs'));
  272.     Tags[6].ti_Tag  := TAG_DONE;
  273.  
  274.     sr := AllocASLRequest(ASL_FileRequest, @Tags[0]);
  275.  
  276.    tempint[4] := TheWindow^.Height;
  277.    While Not exitflag Do Begin
  278.       dummy    := Wait(BitMask(TheWindow^.UserPort^.MP_SIGBIT));
  279.       Repeat
  280.           message  := GT_GetIMsg(TheWindow^.userPort);
  281.           MsgClass := message^.Class;
  282.           MsgCode  := message^.Code;
  283.           GadCode  := pGadget(message^.IAddress);
  284.           StrInfo  := gadcode^.SpecialInfo;
  285.              GT_ReplyIMsg(message);
  286.           Case MsgClass Of
  287.           
  288.              IDCMP_REFRESHWINDOW : RefreshWin;
  289.              
  290.              IDCMP_MOUSEBUTTONS : Begin
  291.                   Case MsgCode Of
  292.                       MENUUP : Begin
  293.                           tempint[1] := TheWindow^.LeftEdge;
  294.                               tempint[2] := TheWindow^.TopEdge;
  295.                               tempint[3] := TheWindow^.Width;
  296.                               If Small Then Begin
  297.                               ChangeWindowBox(TheWindow, tempint[1], tempint[2], tempint[3], Tempint[4]);
  298.                               Small := False;
  299.                           End Else Begin
  300.                               ChangeWindowBox(TheWindow, tempint[1], tempint[2], tempint[3], Sizes[TBS]);
  301.                               Small := True;
  302.                           End;
  303.                       End;
  304.                   End;
  305.               End;
  306.              
  307.              IDCMP_GADGETUP : Begin
  308.                 Case gadcode^.GadgetID Of
  309.                    G_B_TOP : Begin
  310.                       if currentnode <> NIL then begin
  311.                           DetachObjectList;
  312.                           Remove(pNode(CurrentNode));
  313.                           AddHead(CurrentList,pNode(CurrentNode));
  314.                           CurrentTop := 0;
  315.                           CurrentOrd := 0; 
  316.                                 (* Attach object list *)
  317.                                 AttachObjectList;
  318.                                 TxtInGads(currentnode);
  319.                                 RefreshWin;
  320.                      end;
  321.                    End;
  322.                    G_B_UP : Begin
  323.                       pred := pMyNode(Currentnode^.LSK_Node.ln_Pred);
  324.                       if (CurrentNode <> NIL) and (pred <> NIL) then begin
  325.                           DetachObjectList;
  326.                                 (* Move node one position up *)
  327.                         pred := pMyNode(pred^.LSK_Node.ln_Pred);
  328.                         Remove(pNode(CurrentNode));
  329.                         Insert_(CurrentList,pNode(CurrentNode),pNode(pred));
  330.                         CurrentOrd := CurrentOrd - 1;
  331.                         if currentord < 0 then currentord := 0;
  332.                         if currentord < 0 then currentord := 0;
  333.                         if (CurrentOrd>ListViewRows-(ListViewRows div 2)) then
  334.                                 currenttop := CurrentOrd+(ListViewRows div 2)-ListViewRows
  335.                       else currenttop := 0;
  336.                         AttachObjectList;
  337.                         TxtInGads(currentnode);
  338.                         RefreshWin;
  339.                             end;
  340.                    End;
  341.                    G_B_DOWN : Begin
  342.                        succ := pMyNode(currentnode^.LSK_Node.ln_Succ);
  343.                             if (CurrentNode <> NIL) and (succ <> NIL) then begin
  344.                                 DetachObjectList;
  345.                                 Remove(pNode(CurrentNode));
  346.                                 Insert_(CurrentList,pNode(CurrentNode),pNode(succ));
  347.                                 Currentord := currentord + 1;
  348.                                 i := 0;
  349.                                 tmpnode := pMyNode(currentlist^.lh_Head);
  350.                                 While tmpnode <> NIL do begin
  351.                                     i := i + 1;
  352.                                     tmpnode := pMyNode(tmpnode^.LSK_Node.ln_Succ);
  353.                                 end;
  354.                                 i := i-2;
  355.                                 if currentord > i then currentord := i;
  356.                                 if currentord < 0 then currentord := 0;
  357.                                 if (CurrentOrd>ListViewRows-(ListViewRows div 2)) then
  358.                                 currenttop := CurrentOrd+(ListViewRows div 2)-ListViewRows
  359.                       else currenttop := 0;
  360.                                 AttachObjectList;
  361.                                 TxtInGads(currentnode);
  362.                             end;
  363.                          End;
  364.                    G_B_BOTTOM : Begin
  365.                        if currentnode <> NIL then begin
  366.                          DetachObjectList;
  367.                          Remove(pNode(CurrentNode));
  368.                          AddTail(CurrentList,pNode(CurrentNode));
  369.                          tmpnode := pMyNode(currentlist^.lh_Head);
  370.                          i := 0;
  371.                          while tmpnode <> NIL do begin
  372.                              tmpnode := pMyNode(tmpnode^.LSK_Node.ln_Succ);
  373.                              i := i + 1;
  374.                          end;
  375.                          CurrentOrd := i - 1;
  376.                          if (CurrentOrd>ListViewRows-(ListViewRows div 2)) then
  377.                                 currenttop := CurrentOrd+(ListViewRows div 2)-ListViewRows
  378.                       else currenttop := 0;
  379.                          AttachObjectList;
  380.                          TxtInGads(currentnode);
  381.                      end;
  382.                    end;
  383.                    
  384.                    G_B_SORT : SortGadgetFunc;
  385.                    
  386.                    G_B_NEW : Begin
  387.                        DetachObjectList;
  388.                        tmpnode := Add_Name('New Gadget');
  389.                        CurrentNode := tmpnode;
  390.                             CurrentOrd := 0;
  391.                             currenttop := 0;
  392.                             DisableObjectGadgets(False_);
  393.                             TxtInGads(currentnode);
  394.                             AttachObjectList;
  395.                             CD.cd_Down := calcdown(CD.cd_Across);
  396.                    end;
  397.                    
  398.                    G_B_REMOVE : Begin
  399.                      DetachObjectList;
  400.                      DisableObjectGadgets(TRUE_);
  401.                      Remove(pNode(CurrentNode));
  402.                      CurrentNode := NIL;
  403.                      if (CurrentOrd>ListViewRows) then
  404.                                     currenttop := CurrentOrd-ListViewRows+1
  405.                                 else currenttop := 0;
  406.                      CurrentOrd := -1;
  407.                      AttachObjectList;
  408.                      CD.cd_Down := calcdown(CD.cd_Across);
  409.                    end;
  410.                    
  411.                    G_B_COPY : Begin
  412.                             if (CurrentNode <> NIL) then begin
  413.                                 DetachObjectList;
  414.                                 newnode := AllocRemember(@RememberKey, sizeof(tMyNode), MEMF_CLEAR);
  415.                                 newnode^ := CurrentNode^;
  416.                                 (* Correct pointers *)
  417.                                 newnode^.LSK_Node.ln_Name := @newnode^.LSK_Name[1];
  418.                                 if newnode <> NIL then begin
  419.                                     Insert_(CurrentList,pNode(newnode),pNode(CurrentNode));
  420.                                     CurrentNode := newnode;
  421.                                     CurrentOrd := CurrentOrd + 1;
  422.                                     if (CurrentOrd>ListViewRows) then
  423.                                         currenttop := CurrentOrd-ListViewRows+1
  424.                                     else currenttop := 0;
  425.                                 end;
  426.                             AttachObjectList;
  427.                             CD.cd_Down := calcdown(CD.cd_Across);
  428.                             end;
  429.                         end;
  430.                         
  431.                         G_B_SAVE : Begin
  432.                             wl := rtLockWindow(TheWindow);
  433.                             DetachObjectList;
  434.                             IF NOT WriteConfigFile(PREFSDIRH+PREFSNAME) then DisplayBeep(NIL);
  435.                             AttachObjectList;
  436.                             tl := rtUnLockWindow(TheWindow, pointer(wl));
  437.                             exitflag := True;
  438.                         end;
  439.                                             
  440.                    G_B_SAVEAS : Begin
  441.                        wl := rtLockWindow(TheWindow);
  442.                        if AslRequest(sr, NIL) then begin
  443.                            DetachObjectList;
  444.                            cdir := retrievestr(sr^.rf_Dir);
  445.                            
  446.                            (* have to bo this because FExpand & ChDir an' a' them
  447.                               hang the machine *)
  448.  
  449.                            if not (cdir[length(cdir)] = ':') then
  450.                                if not (cdir[length(cdir)] = '/') then 
  451.                                    cdir := cdir + '/';
  452.                            cfile := retrievestr(sr^.rf_file);
  453.                            filename := cdir + cfile;
  454.  
  455.                            IF NOT WriteConfigFile(filename) then DisplayBeep(NIL); 
  456.                            AttachObjectList;
  457.                         end;
  458.                        tl := rtUnLockWindow(TheWindow, pointer(wl));
  459.                    end;
  460.                    
  461.                    G_B_LOAD : Begin
  462.                        wl := rtLockWindow(TheWindow);
  463.                        if AslRequest(lr, NIL) then begin
  464.                            DetachObjectList;
  465.                            cdir := retrievestr(lr^.rf_Dir);
  466.                            
  467.                            (* have to bo this because FExpand & ChDir an' a' them
  468.                               hang the machine *)
  469.                            
  470.                            cnt := 0;
  471.                            for i := 1 to length(cdir) do
  472.                                if cdir[i] = ':' then inc(cnt);
  473.                            CASE cnt of
  474.                             0 : cdir := cdir + ':';
  475.                             1 : if not (cdir[length(cdir)] = ':') then 
  476.                                     cdir := cdir + '/';
  477.                            end;
  478.                            cfile := retrievestr(lr^.rf_file);
  479.                            filename := cdir + cfile;
  480.                            OKRes := ReadConfigFile(filename); 
  481.                            if NOT OKRes then begin  
  482.                                (* Start a' fresh *)
  483.                                CurrentList := AllocRemember(@RememberKey, sizeof(tList), MEMF_CLEAR);
  484.                                    if currentlist = NIL then ErrExit('Failed to allocate list memory'#0, 0);
  485.                                NewList(CurrentList);
  486.                            end ;
  487.                                   CurrentNode := NIL;
  488.                                   CurrentTop := 0;
  489.                                   CurrentOrd := -1;
  490.                                   DisableObjectGadgets(TRUE_);
  491.                            AttachObjectList;
  492.                            UpDateFont; 
  493.                            UpDateAcDown;
  494.                        end; 
  495.                        tl := rtUnLockWindow(TheWindow, pointer(wl));
  496.                    end;
  497.  
  498.                    G_B_CANCEL : exitflag := True;
  499.                    
  500.                    G_S_TXT : Begin
  501.                             if currentnode <> NIL then begin
  502.                            DetachObjectList;
  503.                            remove(pNode(currentnode));
  504.                            currentnode^.LSK_Name := RetrieveStr(strinfo^.Buffer)+#0;
  505.                            Insert_(CurrentList,pNode(currentnode),pNode(currentnode^.LSK_Node.ln_Pred));
  506.                                 AttachObjectList;
  507.                             end;
  508.                             OKRes := ActivateGadget(Gads[G_S_CMD], TheWindow, NIL);
  509.                         end;
  510.                        
  511.                    G_S_CMD : Begin
  512.                        if currentnode <> NIL then begin
  513.                            DetachObjectList;
  514.                            remove(pNode(currentnode));
  515.                            currentnode^.LSK_Cmd := RetrieveStr(strinfo^.Buffer)+#0;
  516.                            Insert_(CurrentList,pNode(currentnode),pNode(currentnode^.LSK_Node.ln_Pred));
  517.                                 AttachObjectList;
  518.                             end;
  519.                             OKRes := ActivateGadget(Gads[G_S_KEY], TheWindow, NIL);
  520.                    end;
  521.                    
  522.                    G_S_KEY : Begin
  523.                        if currentnode <> NIL then begin
  524.                            DetachObjectList;
  525.                            remove(pNode(currentnode));
  526.                            tmpStr := RetrieveStr(strinfo^.Buffer);
  527.                            currentnode^.LSK_Key := UpCase(tmpstr[1]);
  528.                            Insert_(CurrentList,pNode(currentnode),pNode(currentnode^.LSK_Node.ln_Pred));
  529.                                 AttachObjectList;
  530.                             end;
  531.                             OKRes := ActivateGadget(Gads[G_S_TXT], TheWindow, NIL);
  532.                    end;
  533.                    
  534.                    G_LV : Begin
  535.                        detachobjectList;
  536.                       CurrentOrd := msgCode;
  537.                       if currentord < 0 then currentord := 0;
  538.                              if (CurrentOrd>ListViewRows-(ListViewRows div 2)) then
  539.                                 currenttop := CurrentOrd+(ListViewRows div 2)-ListViewRows
  540.                       else currenttop := 0;
  541.                       CurrentNode := pMyNode(CurrentList^.lh_Head);
  542.                       For i := 1 to currentord do
  543.                           CurrentNode := pMyNode(CurrentNode^.LSK_Node.ln_Succ);
  544.  
  545.                        DisableObjectGadgets(False_);
  546.                        TxtInGads(currentnode);
  547.                        attachobjectList;    
  548.                    end;
  549.                    
  550.                      G_IK_ACROS : Begin
  551.                        CD.cd_Across := Strinfo^.Longint_;
  552.                        if CD.cd_Across <= 0 then begin
  553.                            CD.cd_Across := 1;
  554.                            DisplayBeep(NIL);
  555.                            Tags[0].ti_Tag  := GTIN_Number;
  556.                                 Tags[0].ti_Data := CD.cd_Across;
  557.                                 Tags[1].ti_Tag  := TAG_DONE;
  558.                                 GT_SetGadgetAttrsA(gads[G_IK_ACROS], TheWindow, NIL, @Tags);
  559.                        end;
  560.                        CD.cd_Down := calcdown(CD.cd_Across);
  561.                    end;
  562.                    
  563.                    G_B_FONT : begin
  564.                        wl := rtLockWindow(TheWindow);
  565.                        if AslRequest(fr, NIL) then begin
  566.                            CD.cd_Font := fr^.fo_Attr;  
  567.                        end;
  568.                        UpDateFont;
  569.                        tl := rtUnLockWindow(TheWindow, pointer(wl));
  570.                    end;
  571.                    
  572.                    G_S_SCRID : CD.cd_ModeID := GetSCRID;
  573.                    
  574.                    G_B_PALREQ : GetPal;
  575.                    
  576.                    G_B_TITREQ : GetTitles;
  577.                    
  578.                    G_B_INFO  : begin
  579.                        wl := rtLockWindow(TheWindow); 
  580.                         OKRes := ThirdGenAn(TheWindow^.LeftEdge+6, TheWindow^.TopEdge+sizes[TBS]);
  581.                         tl := rtUnLockWindow(TheWindow, pointer(wl));
  582.                     end;
  583.                     
  584.                     G_B_CMDREQ : Begin
  585.                         wl := rtLockWindow(TheWindow);
  586.                        if AslRequest(cr, NIL) then begin
  587.                            cdir := retrievestr(cr^.rf_Dir);
  588.                            
  589.                            (* have to bo this because FExpand & ChDir an' a' them
  590.                               hang the machine *)
  591.                            
  592.                            if not (cdir[length(cdir)] = ':') then
  593.                                if not (cdir[length(cdir)] = '/') then 
  594.                                    cdir := cdir + '/';
  595.                            cfile := retrievestr(cr^.rf_file);
  596.                            filename := cdir + cfile;
  597.                            filename := FExpand(filename);
  598.                                 Tags[0].ti_Tag  := GTST_String;
  599.                                 Tags[0].ti_Data := LONG(CstrConstPtrAR(@RememberKey, filename));
  600.                                 Tags[1].ti_Tag  := TAG_END;
  601.                                 GT_SetGadgetAttrsA(gads[G_S_CMD], TheWindow, NIL, @Tags);                           
  602.                            CurrentNode^.LSK_Cmd := filename+#0;
  603.                        end; 
  604.                        tl := rtUnLockWindow(TheWindow, pointer(wl));
  605.                     end;
  606.                     
  607.                 End; (*case*)
  608.             end;
  609.          End; (*case*)
  610.  
  611.       Until message = NIL;
  612.    End; (*while*)
  613.    FreeAslRequest(fr);
  614.    FreeAslRequest(lr);
  615.    FreeAslRequest(sr);
  616. End;
  617.  
  618. (* ===================================================================== *)
  619.  
  620. (* 
  621.  * Main Procedure 
  622.  *)
  623.  
  624. Procedure main;
  625.  
  626. Begin
  627.   IntuitionBase := pIntuitionBase(OpenLibrary('intuition.library',34));
  628.   if IntuitionBase = NIL then halt(122);
  629.   If IntuitionBase^.LibNode.lib_Version > 36 Then begin
  630.    UtilityBase  := Openlibrary('utility.library',36); 
  631.    If UtilityBase <> NIL Then begin
  632.     GadToolsBase  := Openlibrary('gadtools.library',36); 
  633.     If GadToolsBase <> NIL Then begin
  634.       AslBase  := Openlibrary('asl.library',36); 
  635.      If AslBase <> NIL Then begin
  636.          ReqToolsBase := pReqToolsBase(OpenLibrary(REQTOOLSNAME,REQTOOLSVERSION));
  637.        If ReqToolsBase <> NIL Then begin
  638.         GfxBase := pGfxBase(OpenLibrary('graphics.library',34));
  639.         If ReqToolsBase <> NIL Then begin
  640.        
  641.            CurrentList := AllocRemember(@RememberKey, sizeof(tList), MEMF_CLEAR);
  642.            if currentlist = NIL then ErrExit('Failed to allocate list memory'#0, 0);
  643.          
  644.              CD.cd_Font.ta_Name := CstrConstPtrAR(@RememberKey, 'topaz.font');
  645.              CD.cd_Font.ta_YSize := 8;
  646.              CD.cd_Font.ta_Style := FS_NORMAL;
  647.            CD.cd_Font.ta_Flags := FPF_ROMFONT;
  648.            CD.cd_ModeID := DEFAULT_MONITOR_ID | HIRES_KEY; 
  649.            CD.cd_Across := 1;
  650.            CD.cd_Down := 1;
  651.            CD.cd_ScrTit := 'Startup-Menu ©Lee Kindness'#0;
  652.              CD.cd_WinTit := 'Pick One...'#0; 
  653.            CD.cd_Pal[0] := $AAA;
  654.             CD.cd_Pal[1] := $000;
  655.              CD.cd_Pal[2] := $FFF;
  656.              CD.cd_Pal[3] := $CB4;
  657.  
  658.              if NOT ReadConfigFile(PREFSDIRH+PREFSNAME) then
  659.                 newlist(currentlist);      
  660.            CurrentNode := NIL;
  661.        
  662.             Open_Window;
  663.             UpDateAcDown;
  664.             HandleIDCMP;
  665.             Close_window;
  666.             FreeRemember(@RememberKey, True);
  667.              CloseLibrary (pLibrary(GfxBase));
  668.          end else ErrExit('graphics library v36 (2.0) required'#0, 122);
  669.          CloseLibrary (pLibrary(ReqToolsBase));
  670.         end else ErrExit('Reqtools library v36 (2.0) required'#0, 122);
  671.         CloseLibrary(pLibrary(AslBase));
  672.       end else ErrExit('asl library v36 (2.0) required'#0, 122);
  673.       CloseLibrary(pLibrary(GadToolsBase));
  674.     end else ErrExit('GadTools library v36 (2.0) required'#0, 122);
  675.     CloseLibrary(pLibrary(UtilityBase));
  676.    end else ErrExit('Utility library v36 (2.0) required'#0, 122);
  677.    CloseLibrary(pLibrary(IntuitionBase));
  678.   end else    ErrExit('Intuition library v36 (2.0) required - Upgrade'#0, 122);
  679. end;
  680.  
  681. (* ===================================================================== *)  
  682. begin main end.
  683. (* ===================================================================== *)